home *** CD-ROM | disk | FTP | other *** search
/ PC-Blue - MS DOS Public Domain Library / PC-Blue MS-DOS Public Domain Library - NYACC.iso / vol285 / printper.bas (.txt) < prev    next >
Encoding:
GW-BASIC  |  1987-03-15  |  7.2 KB  |  265 lines
  1. 100  REM PRINTPER Program.
  2. 110  REM Prints Detailed Personal Information
  3. 120  REM Copyright (c) 1983 - 1987 by: Melvin O. Duke.
  4. 130  DEFINT A-Z
  5. 600  REM Titles
  6. 610  TITLE$ = "Print the Persons "
  7. 611  IF DD.ORD$ = "no" THEN 613
  8. 612  TITLE$ = TITLE$ + "and Ordinances "
  9. 613  TITLE$ = TITLE$ + "File"
  10. 620  TITLE$ = TITLE$ + " ON DISPLAY"
  11. 700  REM Terminate if not called from the Menu
  12. 710  IF DD.MENU$ <> "" THEN 770
  13. 720  COLOR 7,0 : KEY ON : CLS : LOCATE 15,1
  14. 730  PRINT "Cannot run the"
  15. 740  PRINT TITLE$
  16. 750  PRINT "Program, unless selected from the MENU"
  17. 760  END
  18. 770  REM OK
  19. 1000  REM Produce the first screen
  20. 1010  KEY ON : CLS : KEY OFF
  21. 1020  REM Draw the outer double box
  22. 1030  R1 = 1 : C1 = 1 : R2 = 24 : C2 = 79 : GOSUB 1300
  23. 1040  REM Find the title location
  24. 1050  TITLE.POS = 40 - INT(LEN(TITLE$)/2)
  25. 1060  REM Draw the title box
  26. 1070  R1=3:C1=TITLE.POS-2:R2=6:C2=TITLE.POS+LEN(TITLE$)+1:GOSUB 1500
  27. 1080  REM Print the title
  28. 1090  LOCATE 4,TITLE.POS : PRINT TITLE$
  29. 1100  LOCATE 5,40-INT(LEN(VERSION$)/2) :  PRINT VERSION$;
  30. 1230  REM Draw the Copyright box
  31. 1240  R1 = 19 : C1 = 21 : R2 = 22 : C2 = 59 : GOSUB 1300
  32. 1250  REM Print the Copyright
  33. 1260  LOCATE 20,40-INT(LEN(COPY1$)/2) :  PRINT COPY1$;
  34. 1270  LOCATE 21,40-INT(LEN(COPY2$)/2) :  PRINT COPY2$;
  35. 1280  GOTO 1700
  36. 1300  REM subroutine to print a double box
  37. 1310  COLOR P
  38. 1320  FOR I = R1 + 1 TO R2 - 1
  39. 1330   LOCATE I, C1 : PRINT CHR$(186);
  40. 1340   LOCATE I, C2 : PRINT CHR$(186);
  41. 1350  NEXT I
  42. 1360   LOCATE R1, C1+1 : PRINT STRING$(C2-C1-1,205);
  43. 1390   LOCATE R2, C1+1 : PRINT STRING$(C2-C1-1,205);
  44. 1400   LOCATE R1, C1 : PRINT CHR$(201);
  45. 1410   LOCATE R1, C2 : PRINT CHR$(187);
  46. 1420   LOCATE R2, C1 : PRINT CHR$(200);
  47. 1430   LOCATE R2, C2 : PRINT CHR$(188);
  48. 1440  COLOR W
  49. 1450  RETURN
  50. 1500  REM subroutine to print a single box
  51. 1510  COLOR B
  52. 1520  FOR I = R1 + 1 TO R2 - 1
  53. 1530   LOCATE I, C1 : PRINT CHR$(179);
  54. 1540   LOCATE I, C2 : PRINT CHR$(179);
  55. 1550  NEXT I
  56. 1560   LOCATE R1, C1+1 : PRINT STRING$(C2-C1-1,196);
  57. 1590   LOCATE R2, C1+1 : PRINT STRING$(C2-C1-1,196);
  58. 1600   LOCATE R1, C1 : PRINT CHR$(218);
  59. 1610   LOCATE R1, C2 : PRINT CHR$(191);
  60. 1620   LOCATE R2, C1 : PRINT CHR$(192);
  61. 1630   LOCATE R2, C2 : PRINT CHR$(217);
  62. 1640  COLOR W
  63. 1650  RETURN
  64. 1700  REM ask user to press a key to continue
  65. 1710  LOCATE 25,1
  66. 1720  PRINT "Have Data Diskette(s) in Place, then Press any key to continue.";
  67. 1730  K$ = INKEY$ : IF K$ = "" THEN 1730
  68. 1740  KEY ON : CLS : KEY OFF
  69. 2000  REM PRINTPER Program Starts Here.
  70. 2010  IF DD.ORD$ = "no" THEN 2050
  71. 2020  OPEN DD.ORD$+"ordfile" AS #2 LEN = 256
  72. 2030  FIELD 2,5ASO1$,11ASO2$,11ASO3$,11ASO4$,5ASO5$,5ASO6$,11ASO7$,11ASO8$,11ASO9$,11ASO10$,11ASO11$,5ASO12$,11ASO13$,11ASO14$,11ASO15$,11ASO16$,11ASO17$,11ASO18$,11ASO19$,11ASO20$,11ASO21$,11ASO22$,11ASO23$,26ASO24$
  73. 2040  REM
  74. 2050  OPEN DD.PERS$+"persfile" AS #1 LEN = 256
  75. 2060  FIELD 1, 5 AS F1$, 20 AS F2$, 30 AS F3$, 2 AS F4$, 5 AS F5$, 5 AS F6$, 5 AS F7$, 11 AS F8$, 18 AS F9$, 16 AS F10$, 16 AS F11$, 11 AS F12$, 18 AS F13$, 16 AS F14$, 16 AS F15$, 11 AS F16$, 18 AS F17$, 16 AS F18$, 16 AS F19$
  76. 2070  REM Read all records, and print the actual ones
  77. 2080  KEY ON : CLS : KEY OFF
  78. 2090  LOCATE 22,1
  79. 2100  PRINT "Enter the Record Number to be Printed (0 to quit) or 'all': ";
  80. 2110  LINE INPUT REPLY$
  81. 2120  IF LEFT$(REPLY$,1) = "a" OR LEFT$(REPLY$,1) = "A" THEN 2180
  82. 2130  IF REPLY$ = "0" THEN 3760
  83. 2140  I = VAL(REPLY$)
  84. 2150  IF I < 1 OR I > MAX.PER THEN KEY ON : CLS : KEY OFF : LOCATE 22,1 : PRINT "Number is out of range"; : GOTO 2090
  85. 2160  GOSUB 2230  'to print
  86. 2170  GOTO 2080
  87. 2180  IF START.PER < 1 THEN START.PER = 1
  88. 2190  KEY ON : CLS : KEY OFF
  89. 2200  FOR I = START.PER TO MAX.PER
  90. 2210  GOSUB 2230
  91. 2220  GOTO 3750
  92. 2230  GET #1, I
  93. 2240  LOCATE 23,1 : PRINT "Processing Record #";I
  94. 2250  REM Extract information from the file for use
  95. 2260  T1! = CVS(F1$) : T1 = T1!
  96. 2270  IF T1 < 1 THEN 3740  'return
  97. 2280  REM Print a Title on Each Page
  98. 2290  LPRINT ,"Content of the Persons ";
  99. 2300  IF DD.ORD$ = "no" THEN 2320
  100. 2310  LPRINT "and Ordinances ";
  101. 2320  IF DD.ORD$ = "no" THEN LPRINT "File" ELSE LPRINT "Files"
  102. 2330  LPRINT ,DATE$, TIME$
  103. 2340  LPRINT
  104. 2350  T2$ = F2$
  105. 2360  T3$ = F3$
  106. 2370  FOR J = 1 TO LEN(F3$)-1
  107. 2380   IF RIGHT$(T3$,1)=" "THEN T3$ = LEFT$(T3$,LEN(T3$)-1) ELSE J = LEN(F3$)-1
  108. 2390  NEXT J
  109. 2400  T4$ = F4$
  110. 2410  IF LEFT$(T4$,1) = MALE.LTR$   THEN T4$ = MALE.SEX$
  111. 2420  IF LEFT$(T4$,1) = FEMALE.LTR$ THEN T4$ = FEMALE.SEX$
  112. 2430  T5! = CVS(F5$)
  113. 2440  T6! = CVS(F6$) : T6 = T6!
  114. 2450  T7! = CVS(F7$) : T7 = T7!
  115. 2460  T8$ = F8$
  116. 2470  T9$ = F9$
  117. 2480  T10$ = F10$
  118. 2490  T11$ = F11$
  119. 2500  T12$ = F12$
  120. 2510  T13$ = F13$
  121. 2520  T14$ = F14$
  122. 2530  T15$ = F15$
  123. 2540  T16$ = F16$
  124. 2550  T17$ = F17$
  125. 2560  T18$ = F18$
  126. 2570  T19$ = F19$
  127. 2580  IF DD.ORD$ = "no" THEN 2870
  128. 2590  REM Extract Ordinance Information
  129. 2600  GET #2, I
  130. 2610  U1! = CVS(O1$) : U1 = U1!
  131. 2620  REM bypass if no Ordinances Record Present
  132. 2630  IF U1 = 0 THEN GOSUB 3870 : GOTO 2870
  133. 2640  U2$ = O2$
  134. 2650  U3$ = O3$
  135. 2660  U4$ = O4$
  136. 2670  U5! = CVS(O5$) : U5 = U5!
  137. 2680  U6! = CVS(O6$) : U6 = U6!
  138. 2690  U7$ = O7$
  139. 2700  U8$ = O8$
  140. 2710  U9$ = O9$
  141. 2720  U10$ = O10$
  142. 2730  U11$ = O11$
  143. 2740  U12! = CVS(O12$) : U12 = U12!
  144. 2750  U13$ = O13$
  145. 2760  U14$ = O14$
  146. 2770  U15$ = O15$
  147. 2780  U16$ = O16$
  148. 2790  U17$ = O17$
  149. 2800  U18$ = O18$
  150. 2810  U19$ = O19$
  151. 2820  U20$ = O20$
  152. 2830  U21$ = O21$
  153. 2840  U22$ = O22$
  154. 2850  U23$ = O23$
  155. 2860  U24$ = O24$
  156. 2870  REM Print out of Personal Information
  157. 2880  LPRINT BOLD.ON$;
  158. 2890  LPRINT ,"Personal Information"
  159. 2900  LPRINT BOLD.OFF$;
  160. 2910  LPRINT
  161. 2920  LPRINT ,"Record-Number:",T1
  162. 2930  LPRINT ,"Surname:",,T2$
  163. 2940  LPRINT ,"Given-names:",,T3$
  164. 2950  LPRINT ,"Sex:",,T4$
  165. 2960  LPRINT ,"Code:",,T5!
  166. 2970  LPRINT ,"Father's Record-number:",T6
  167. 2980  LPRINT ,"Father's Name: ",
  168. 2990  IF T6 = 0 THEN LPRINT : GOTO 3040
  169. 3000  GET #1, T6
  170. 3010  TMP$ = F2$ : GOSUB 3810 : TT2$ = TMP$
  171. 3020  TMP$ = F3$ : GOSUB 3810 : TT3$ = TMP$
  172. 3030  LPRINT LEFT$(TT3$ + " " + TT2$,33)
  173. 3040  LPRINT ,"Mother's Record-number:",T7
  174. 3050  LPRINT ,"Mother's Name: ",
  175. 3060  IF T7 = 0 THEN LPRINT : GOTO 3110
  176. 3070  GET #1, T7
  177. 3080  TMP$ = F2$ : GOSUB 3810 : TT2$ = TMP$
  178. 3090  TMP$ = F3$ : GOSUB 3810 : TT3$ = TMP$
  179. 3100  LPRINT LEFT$(TT3$ + " " + TT2$,33)
  180. 3110  LPRINT ,"Birth-date:",,T8$
  181. 3120  LPRINT ,"Birth-city:",,T9$
  182. 3130  LPRINT ,"Birth-county:",,T10$
  183. 3140  LPRINT ,"Birth-state:",,T11$
  184. 3150  LPRINT ,"Death-date:",,T12$
  185. 3160  LPRINT ,"Death-city:",,T13$
  186. 3170  LPRINT ,"Death-county:",,T14$
  187. 3180  LPRINT ,"Death-state:",,T15$
  188. 3190  LPRINT ,"Burial-date:",,T16$
  189. 3200  LPRINT ,"Burial-city:",,T17$
  190. 3210  LPRINT ,"Burial-county:",T18$
  191. 3220  LPRINT ,"Burial-state:",,T19$
  192. 3230  LPRINT : LPRINT : LPRINT
  193. 3240  IF DD.ORD$ = "no" THEN 3730
  194. 3250  LPRINT BOLD.ON$;
  195. 3260  LPRINT ,"Ordinance Information"
  196. 3270  LPRINT BOLD.OFF$;
  197. 3280  LPRINT
  198. 3290  REM Print the Ordinance Information
  199. 3300  LPRINT ,"Christening Date:",U2$
  200. 3310  LPRINT ,"Blessing Date:",U3$
  201. 3320  LPRINT ,"Sealed to Parents:",U4$
  202. 3330  LPRINT ,"Father's Record-Number:",U5
  203. 3340  LPRINT ,"Father's Name: ",
  204. 3350  IF U5 = 0 THEN LPRINT : GOTO 3400
  205. 3360  GET #1, U5
  206. 3370  TMP$ = F2$ : GOSUB 3810 : TT2$ = TMP$
  207. 3380  TMP$ = F3$ : GOSUB 3810 : TT3$ = TMP$
  208. 3390  LPRINT LEFT$(TT3$ + " " + TT2$,33)
  209. 3400  LPRINT ,"Mother's Record-Number:",U6
  210. 3410  LPRINT ,"Mother's Name: ",
  211. 3420  IF U6 = 0 THEN LPRINT : GOTO 3470
  212. 3430  GET #1, U6
  213. 3440  TMP$ = F2$ : GOSUB 3810 : TT2$ = TMP$
  214. 3450  TMP$ = F3$ : GOSUB 3810 : TT3$ = TMP$
  215. 3460  LPRINT LEFT$(TT3$ + " " + TT2$,33)
  216. 3470  LPRINT ,"Baptism Date:",,U7$
  217. 3480  LPRINT ,"Confirmation Date:",U8$
  218. 3490  LPRINT ,"Patriarchal Blessing:",U9$
  219. 3500  LPRINT ,"Endowment Date:",U10$
  220. 3510  IF LEFT$(T4$,1) = "M" THEN 3600
  221. 3520  LPRINT ,"Sealed to Husband Date:",U11$
  222. 3530  LPRINT ,"Husband's Record-Number:",U12
  223. 3540  LPRINT ,"Husband's Name: ",
  224. 3550  IF U12 = 0 THEN LPRINT : GOTO 3600
  225. 3560  GET #1, U12
  226. 3570  TMP$ = F2$ : GOSUB 3810 : TT2$ = TMP$
  227. 3580  TMP$ = F3$ : GOSUB 3810 : TT3$ = TMP$
  228. 3590  LPRINT LEFT$(TT3$ + " " + TT2$,33)
  229. 3600  IF LEFT$(T4$,1) <> "M" THEN 3720
  230. 3610  LPRINT ,"Aaronic Priesthood Date:",U13$
  231. 3620  LPRINT ,"Deacon Date:",,U14$
  232. 3630  LPRINT ,"Teacher Date:",,U15$
  233. 3640  LPRINT ,"Priest Date:",,U16$
  234. 3650  LPRINT ,"Melchizedek Priesthood:",U17$
  235. 3660  LPRINT ,"Elder Date:",,U18$
  236. 3670  LPRINT ,"Seventy Date:",,U19$
  237. 3680  LPRINT ,"High Priest Date:",U20$
  238. 3690  LPRINT ,"Bishop Date:",,U21$
  239. 3700  LPRINT ,"Patriarch Date:",U22$
  240. 3710  LPRINT ,"Apostle Date:",,U23$
  241. 3720  LPRINT ,"Occupation:",,U24$
  242. 3730  LPRINT FORM.FEED$;
  243. 3740  RETURN
  244. 3750  NEXT I
  245. 3760  CLOSE #1
  246. 3770  CLOSE #2
  247. 3780  KEY ON : CLS : KEY OFF : LOCATE 21,1
  248. 3790  PRINT "End of Program"
  249. 3800  RUN DD.MENU$+"menu"
  250. 3810  REM Right-trim routine
  251. 3820  TMP2$ = TMP$
  252. 3830  FOR TRM = 1 TO LEN(TMP$)-1
  253. 3840   IF RIGHT$(TMP$,1) = " " THEN TMP$ = LEFT$(TMP$,LEN(TMP$)-1) ELSE TRM = LEN(TMP2$)-1
  254. 3850  NEXT TRM
  255. 3860  RETURN
  256. 3870  REM Blank Ordinances if No Ord Record
  257. 3880  U2$  = "" : U3$  = "" : U4$  = ""
  258. 3890  U5   = 0  : U6   = 0  : U12  = 0
  259. 3900  U7$  = "" : U8$  = "" : U9$  = "" : U10$ = ""
  260. 3910  U11$ = "" : U13$ = "" : U14$ = "" : U15$ = ""
  261. 3920  U16$ = "" : U17$ = "" : U18$ = "" : U19$ = ""
  262. 3930  U20$ = "" : U21$ = "" : U22$ = "" : U23$ = ""
  263. 3940  U24$ = ""
  264. 3950  RETURN
  265.